home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Pascal / Source□ / Talk Source / My Libraries / MyPreferences.unit < prev    next >
Encoding:
Text File  |  1992-04-20  |  4.3 KB  |  171 lines  |  [TEXT/PJMM]
  1. unit MyPreferences;
  2.  
  3. { This program was written by Peter N Lewis, Mar 1992 in THINK Pascal 4.0.1 }
  4.  
  5. interface
  6.  
  7.     uses
  8.         Folders, PrefsGlobals;
  9.  
  10.     procedure GetPrefsFSSpec (var fs: FSSpec);
  11.     function OpenPrefsFile (fs: FSSpec): integer;
  12.     function MakePrefsFile (fs: FSSpec): integer;
  13.     procedure GetPrefs (var prefs: prefsRecord);
  14.     procedure SetPrefs (var prefs: prefsRecord);
  15.     procedure JustGetPrefs (var prefs: prefsRecord);
  16.     procedure JustSetPrefs (var prefs: prefsRecord);
  17.     function GetPrefsResource (res: resType; id: integer; var h: handle): integer;
  18.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  19.  
  20. implementation
  21.  
  22.     procedure GetPrefsFSSpec (var fs: FSSpec);
  23.         var
  24.             gv: longInt;
  25.             oe: OSErr;
  26.             pb: HParamBlockRec;
  27.             sysenv: SysEnvRec;
  28.             s: str255;
  29.             dummy: longInt;
  30.     begin
  31.         if (Gestalt(gestaltFindFolderAttr, gv) <> noErr) | (not BTST(gv, gestaltFindFolderPresent)) | (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, fs.vRefNum, fs.parID) <> NoErr) then begin
  32.             oe := SysEnvirons(1, sysenv);
  33.             with pb do begin
  34.                 fs.vRefNum := sysenv.sysVRefNum;
  35.                 s := 'Preferences';
  36.                 if DirCreate(sysenv.sysVRefNum, 0, s, fs.parID) <> noErr then begin
  37.                     ioNamePtr := @s;
  38.                     ioVRefNum := fs.vRefNum;
  39.                     ioFDirIndex := 0;
  40.                     ioDirID := 0;
  41.                     if (PBGetCatInfo(@pb, false) = noErr) & (BAND(ioFlAttrib, $0010) <> 0) then
  42.                         fs.parID := pb.ioDirID
  43.                     else
  44.                         fs.parID := 0;
  45.                 end;
  46.             end;
  47.         end;
  48.         GetIndString(s, prefsStrhResID, prefsNameStrhIndex);
  49.         fs.name := s;
  50.     end;
  51.  
  52.     function OpenPrefsFile (fs: FSSpec): integer;
  53.     begin
  54.         OpenPrefsFile := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdPerm);
  55.     end;
  56.  
  57.     function MakePrefsFile (fs: FSSpec): integer;
  58.         const
  59.             finderLaunchStrID = -16397;
  60.         var
  61.             oe: OSErr;
  62.             sh: stringHandle;
  63.             s: str255;
  64.             rn: integer;
  65.     begin
  66.         oe := HCreate(fs.vRefNum, fs.parID, fs.name, prefsCreator, prefsType);
  67.         HCreateResFile(fs.vRefNum, fs.parID, fs.name);
  68.         rn := HOpenResFile(fs.vRefNum, fs.parID, fs.name, fsRdWrPerm);
  69.         if rn <> -1 then begin
  70.             sh := stringHandle(Get1Resource('STR ', finderLaunchStrID));
  71.             if sh = nil then begin
  72.                 GetIndString(s, prefsStrhResID, prefsFinderCommentStrhIndex);
  73.                 sh := NewString(s);
  74.                 if sh <> nil then
  75.                     AddResource(handle(sh), 'STR ', finderLaunchStrID, 'Finder launch string');
  76.             end;
  77.         end;
  78.         MakePrefsFile := rn;
  79.     end;
  80.  
  81.     type
  82.         prefsPtr = ^prefsRecord;
  83.         prefsHandle = ^prefsPtr;
  84.  
  85.     procedure GetPrefs (var prefs: prefsRecord);
  86.         var
  87.             h: handle;
  88.     begin
  89.         h := GetResource(prefsResType, prefsResID);
  90.         prefs.version := -1;
  91.         if (h <> nil) & (GetHandleSize(h) = SizeOf(prefsRecord)) then
  92.             prefs := prefsHandle(h)^^;
  93.         ValidatePrefs(prefs);
  94.     end;
  95.  
  96.     procedure SetPrefs (var prefs: prefsRecord);
  97.         var
  98.             h: handle;
  99.             i: integer;
  100.     begin
  101.         h := Get1Resource(prefsResType, prefsResID);
  102.         if h = nil then begin
  103.             h := NewHandle(SizeOf(prefsRecord));
  104.             if h <> nil then
  105.                 AddResource(h, prefsResType, prefsResID, 'Prefs');
  106.         end;
  107.         if h <> nil then begin
  108.             SetHandleSize(h, SizeOf(prefsRecord));
  109.             prefsHandle(h)^^ := prefs;
  110.             ChangedResource(h);
  111.         end;
  112.     end;
  113.  
  114.     procedure JustGetPrefs (var prefs: prefsRecord);
  115.         var
  116.             prefs_fs: FSSpec;
  117.             prefs_rn: integer;
  118.     begin
  119.         GetPrefsFSSpec(prefs_fs);
  120.         prefs_rn := OpenPrefsFile(prefs_fs);
  121.         GetPrefs(prefs);
  122.         if prefs_rn <> -1 then
  123.             CloseResFile(prefs_rn);
  124.     end;
  125.  
  126.     procedure JustSetPrefs (var prefs: prefsRecord);
  127.         var
  128.             prefs_fs: FSSpec;
  129.             prefs_rn: integer;
  130.     begin
  131.         GetPrefsFSSpec(prefs_fs);
  132.         prefs_rn := MakePrefsFile(prefs_fs);
  133.         if prefs_rn <> -1 then begin
  134.             SetPrefs(prefs);
  135.             CloseResFile(prefs_rn);
  136.         end;
  137.     end;
  138.  
  139.     function GetPrefsResource (res: resType; id: integer; var h: handle): integer;
  140.         var
  141.             prefs_fs: FSSpec;
  142.             prefs_rn: integer;
  143.     begin
  144.         GetPrefsFSSpec(prefs_fs);
  145.         prefs_rn := OpenPrefsFile(prefs_fs);
  146.         h := GetResource(res, id);
  147.         GetPrefsResource := prefs_rn;
  148.     end;
  149.  
  150.     procedure SetPrefsResource (res: resType; id: integer; h: handle);
  151.         var
  152.             prefs_fs: FSSpec;
  153.             prefs_rn: integer;
  154.             h2: handle;
  155.     begin
  156.         if h <> nil then begin
  157.             GetPrefsFSSpec(prefs_fs);
  158.             prefs_rn := MakePrefsFile(prefs_fs);
  159.             if prefs_rn <> -1 then begin
  160.                 h2 := Get1Resource(res, id);
  161.                 if h2 <> nil then begin
  162.                     RmveResource(h2);
  163.                     DisposHandle(h2);
  164.                 end;
  165.                 AddResource(h, res, id, '');
  166.                 CloseResFile(prefs_rn);
  167.             end;
  168.         end;
  169.     end;
  170.  
  171. end.